COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	entry  seg
C00018 ENDMK
C⊗;
entry  seg;
begin   "seg"

  comment    Programmed by K Ramesh Babu;

  require  "define.sai"  source!file;
  require  "grafix.dcl"  source!file;
  require  "tenexio.sai" source!file;

  external  string  picture;

  DEFINE  ID2CHECK = "FALSE",
          INSTRUMENTATION = "FALSE";

  record!class  seg(
    integer  name, family, pred, succ, fork;
    integer  pr1, pr2, pc1, pc2;
    real  length, theta);
  record!pointer(seg)  pseg;
  define  segsz = "11", ssegsz = "8";

  integer  segfile;
  safe  integer  array  sghdr [0:hdrl-1];
  define  rowsz = "sghdr[32]",
          colsz = "sghdr[33]",
          segno = "sghdr[34]",
          filtval = "sghdr[35]";
  integer  rrecsz, wrecsz;
  string  s;

  DEFINE  SAMESIDE(THRUR,THRUC,OTHERR,OTHERC,TESTR,TESTC)="
    (TESTR-THRUR)*(OTHERR-THRUR) 
  + (TESTC-THRUC)*(OTHERC-THRUC) > 0";

  comment (about procedures)
	These are procedures acting on the segment and super-
    	segment data structures as defined by <babu>seg.data.
	It is recommended that use be made of these, and these only, 
  	for any purpose of doing input, computation, or output of
	these data structures. Note: Correct initialisation must
	be employed.;

  internal  simple  procedure  sgreset;
  begin
    swdptr(segfile,hdrl);
  end;  "sgreset"

  internal  simple  procedure  sgout;
  begin
  comment  Outputs a record (of a segment) onto the disk.;
    arryout(segfile,seg:name[pseg],segsz);
  end;

  internal  simple  procedure  sgin;
  begin
  comment  Reads a record of segment from a disk file.;
    arryin(segfile,seg:name[pseg],rrecsz);
  end;

  internal  simple  procedure  sginid(integer id);
  begin
    swdptr(segfile,(id-1)*rrecsz+hdrl);  sgin;
  end;

  internal  simple  procedure  sgrdopen;
  begin
  comment  Opens (s)seg file(s) for reading.;
  integer  c;
    pseg := new!record(seg);
    segfile := openfile(picture & ".seg","rc");
    arryin(segfile,sghdr[0],HDRL);
    print(picture," has ",segno," segments.",crlf);
    rrecsz := sghdr[2];
  end;

  internal  simple  procedure  sgwtopen;
  begin
  comment
  Opens diskfiles for writing(only, I guess);
    pseg := new!record(seg);  segno := 0;
    segfile := openfile(picture & ".seg","wc");
    swdptr(segfile,hdrl);
  end;

  internal  simple  procedure  sgclose;
  begin
    cfile(segfile);
  end;

  internal  simple  procedure  wsghdr;
  begin
  comment  Write headers onto (s)seg file(s).;
    sghdr[0] :=  128;          sghdr[1] := 36;
    sghdr[2] := segsz;         sghdr[3] := segsz;
    sghdr[4] := segsz * segno; sghdr[5] := '1000001; 
    swdptr(segfile,0);  arryout(segfile,sghdr[0],128);
    print(picture," has  ",segno," segments.",crlf);
    print(picture," is ",rowsz," X ",colsz,crlf);
  end;

  internal  simple  procedure  arrows;
  begin
  real  rrp, ccp, rrm, ccm;
  comment  Displays a segment with short arrowheads and tails.;
    rrp := cd[seg:theta[pseg] + 135];
    CCp := sd[seg:theta[pseg] + 135]; 
    movea(1.0*seg:pc1[pseg],-1.0*seg:pr1[pseg]);
    drawa(1.0*(seg:pc1[pseg] + ccp),-1.0*(seg:pr1[pseg] + RRp));
    " rrm := cd[seg:theta[pseg] - 135]; "  RRM  := -ccp;
    " CCm := sd[seg:theta[pseg] 135]; "  ccm := rrp;
    movea(1.0*(seg:pc1[pseg] + CCm), -1.0*(seg:pr1[pseg] + rrm));
    drawa(1.0*seg:pc1[pseg] ,-1.0*SEG:pr1[pseg]);
    drawa(1.0*seg:pc2[pseg],-1.0*seg:pr2[pseg]);
    drawa(1.0*(seg:pc2[pseg] + CCP), -1.0*(SEG:pr2[pseg]+RRP));
    movea(1.0*(seg:pc2[pseg] + ccm), -1.0*(seg:pr2[pseg] + RRM));
    drawa(1.0*seg:pc2[pseg], -1.0*seg:pr2[pseg]);
  end;  "arrows"
    
  internal  simple  procedure  sgtty;
  begin  "sgtty"
        print(" name: ",seg:name[pseg]);
        print(" family: ",seg:family[pseg], crlf);
        print(" pred: ",seg:pred[pseg]);
        print(" succ: ",seg:succ[pseg]);
        print(" fork: ",seg:fork[pseg], crlf);
        PRINT(" FROM ",SEG:PR1[PSEG],",",SEG:PC1[PSEG]);
        PRINT(" TO ",SEG:PR2[PSEG],",",SEG:PC2[PSEG],CRLF);
        print(" length: ",seg:length[pseg]);
        print(" theta: ",seg:theta[pseg], crlf);
  END  "sgtty" ;

  DEFINE  APARMKTESTING = "FALSE";
  internal  boolean  procedure  sgoverlap(integer id1,id2);
  begin
  record!pointer (seg)  p1, p2;
    p1 := new!record(seg);  p2 := new!record(seg);
    swdptr(segfile,hdrl+(id1-1)*rrecsz);
    arryin(segfile,seg:name[p1],rrecsz);
    swdptr(segfile,hdrl+(id2-1)*rrecsz);
    arryin(segfile,seg:name[p2],rrecsz);
    if  sameside(seg:pr1[p1],seg:pc1[p1],seg:pr2[p1],seg:pc2[p1],SEG:pr2[p2],seg:pc2[p2])  and
        sameside(seg:pr2[p1],seg:pc2[p1],seg:pr1[p1],seg:pc1[p1],SEG:pr1[p2],seg:pc1[p2])  
      then  return(true)  else  return(false);
  end;

  internal  simple  procedure  filter;
  begin  "filter"
  integer  output;
  integer  c, k, ss, oss, kss;  real  minl;
    output := openfile(picture & ".seg1","wc");
    swdptr(output,hdrl);  wrecsz := rrecsz;
    Print("This filter will pass only those that are >, not >=, the minimum length.",crlf);
    c := 0;  k := 0;  rprmpt("min length",minl);
    filtval := minl;
    ss := 0;  oss := 0;  kss := 0;
    while  c < segno  do
    begin
      sgin;  c := c + 1;  ss := seg:family[pseg];
      if  seg:length[pseg] > minl  then
      begin
        k := k + 1;  seg:name[pseg] := k;
        if  ss neq oss  then  kss := kss + 1;
        seg:family[pseg] := kss;  seg:pred[pseg] := 0;
        seg:succ[pseg] := 0;  seg:fork[pseg] := 0;
        arryout(output,seg:name[pseg],wrecsz);
        oss := ss;
      end;
    end;
    segno := k;
    swdptr(output,0);  arryout(output,sghdr[0],hdrl);
    cfile(output);
  end  "filter" ;

  internal  procedure  segzoom;
  begin  "segzoom"
  integer  size, rbeg, cbeg, rwsz, cwsz, rend, cend;

  boolean  more;
  integer  c;
    clipinit(rowsz,colsz);
    do  begin
      BEGINDISPLAY;
      sgreset;
      FOR  c := 1 step 1 until segno  do
      begin
      integer  r1, c1, r2, c2;
        sgin;
        r1 := seg:pr1[pseg];  r2 := seg:pr2[pseg];
        c1 := seg:pc1[pseg];  c2 := seg:pc2[pseg];
        clipdsp(r1,c1,r2,c2);
      end;
      legend(picture & ".seg");
      endisplay;
      bprmpt(" Any more",more);
    end  until  not(more);
  
  end  "segzoom" ;

  internal  simple  procedure  segpicsize;
  print(picture," is ",rowsz," x ",colsz,".",crlf);

  internal  simple procedure  sgrwopen;
  begin
  ! opens a supersegment file for updating (or, editing).
    Note: Old file is destroyed.;

    segfile := openfile(picture & ".seg","rwo");
    pseg := new!record(seg);
    arryin(segfile,sghdr[0],hdrl);
  end;

  internal  simple  real  procedure  seglen(integer id);
  begin
    sginid(id);
    return(seg:length[pseg]);
  end;

  internal  simple  integer  procedure  segfamily(integer segid);
  begin
    sginid(segid);
    return(seg:family[pseg]);
  end;

  internal  simple  procedure  sginto(integer id; reference
  record!pointer (seg) ptr);
  begin
    swdptr(segfile,(id-1)*rrecsz+hdrl);
    arryin(segfile,seg:name[ptr],rrecsz);
  END;

  internal  simple  real  procedure  sdist(integer cid, t);
  begin
  ! Procedure to compute the distance of the projection of the 
    second coordinate of segment t on segment cid. The distance 
    is measured from the first coordinate of the segment c.  
    Note: It is assumed that the two segments are antiparallel,
    so that the  second coordinate of the second segment(t) is
    closer to the first coordinate of the first(cid).;
  integer  r, c, deg;
    sginid(t);
    r := seg:pr2[pseg];
    c := seg:pc2[pseg];
    sginid(cid);  deg := seg:theta[pseg];
    return((r-seg:pr1[pseg])*cd[deg] + (C-seg:pc1[pseg])*sd[deg]);
  end;

  internal  simple  integer  procedure  noofsegs;
  return(segno);

  internal  simple  procedure  segtofile(integer  chan);
  begin
    sgin;
    cprint(chan," name: ",seg:name[pseg]);
    cprint(chan," family: ",seg:family[pseg]);
    cprint(chan," pred: ",seg:pred[pseg]);
    cprint(chan," succ: ",seg:succ[pseg]);
    cprint(chan," fork: ",seg:fork[pseg], crlf);
    cprint(chan," FROM ",SEG:PR1[PSEG],",",SEG:PC1[PSEG]);
    cprint(chan," TO ",SEG:PR2[PSEG],",",SEG:PC2[PSEG],CRLF);
    cprint(chan," length: ",seg:length[pseg]);
    cprint(chan," theta: ",seg:theta[pseg], crlf,crlf);
  end;

  internal  simple  real  procedure  segangle(integer  segid);
  begin
    sginid(segid);
    return(seg:theta[pseg]);
  end;

  internal  simple  procedure  get1s(reference  integer r, c);
  begin
  ! Returns the first coordinates of the segment currently addressed;
    r := seg:pr1[pseg];  c := seg:pc1[pseg];
  end;

  internal  simple  procedure  get2s(reference  integer r, c);
  begin
  ! Returns the second coordinates of the segment currently addressed;
    r := seg:pr2[pseg];  c := seg:pc2[pseg];
  end;

  internal  simple  procedure  sgdinit;
  clipinit(rowsz,colsz);

  internal  simple  procedure  getsgsize(reference integer r, c);
  begin
  ! returns the size of the picture;
    r := rowsz;  c := colsz;
  end;

  internal  simple  procedure  sgdep(integer n,f,p,s,fk,r1,c1,r2,c2;
    real  l,t);
  begin
    seg:name[pseg] := n;  seg:family[PSEG] := f;
    seg:pred[pseg] := p;  seg:succ[PSEG] := s;
    seg:fork[pseg] := fk;
    seg:pr1[pseg] := r1;  seg:pc1[PSEG] := c1;
    seg:pr2[pseg] := r2;  seg:pc2[PSEG] := c2;
    seg:length[pseg] := l;  seg:theta[PSEG] := t;
    sgout;
  end;

  internal  simple  procedure  depsg(integer s, r, c);
  begin
    segno := s;  rowsz := r;  colsz := c;
  end;

  internal  simple  procedure  sgssgch;
begin
! checks if their is any record in .seg file which has
  a segid < ssegid and outputs the corresp seg id's.;
integer  c;
    for  c := 1 step 1 until  segno  do
    begin
      sgin;
      if  seg:name[pseg] < seg:family[pseg]  then
      print(" wrong seg record -- ",seg:name[pseg],crlf);
      end;
  end;

end  "seg"